home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlLastModified.tcl < prev    next >
Encoding:
Text File  |  2001-01-14  |  16.2 KB  |  427 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlLastModified.tcl"
  6.  #                                    created: 99-07-20 23.04.50 
  7.  #                                last update: 01-01-14 15.06.10 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains procs for updating the Last Modified date.
  35. #===============================================================================
  36.  
  37. #===============================================================================
  38. # ◊◊◊◊ Last modified ◊◊◊◊ #
  39. #===============================================================================
  40.  
  41. proc html::LastModified {} {
  42.     global HTMLmodeVars html::DateFormat 
  43.     set values [dialog -w 320 -h 260 -t "Last modified tags" 40 10 210 30 \
  44.     -e $HTMLmodeVars(lastModified) 10 40 310 55 -t "Date format" 10 70 100 90 \
  45.     -r "Relaxed ISO" 1 10 95 110 115 -r "Strict ISO" 0 120 95 220 115 \
  46.     -r "Long" 0 10 120 70 140 -r "Abbreviated" 0 80 120 180 140 -r "Short" 0 190 120 250 140 \
  47.     -c "Include weekday" 0 10 145 150 165 -c "Include time" 0 155 145 290 165 \
  48.     -c "Time with seconds" 0 175 170 310 190 \
  49.     -t "Language" 10 200 100 220 -m [concat [list { } { }] [lsort [array names html::DateFormat]]] \
  50.     110 200 290 220 -b OK 20 230 85 250 -b Cancel 110 230 175 250]
  51.     if {[lindex $values 11]} {return}
  52.     set lm [html::Quote [lindex $values 0]]
  53.     set text "<!-- [html::SetCase "#LASTMODIFIED TEXT"]=\"$lm\" [html::SetCase FORM]=\""
  54.     if {[lindex $values 1]} {append text [html::SetCase RELAXED]}
  55.     if {[lindex $values 2]} {append text [html::SetCase ISO]}
  56.     if {[lindex $values 3]} {append text [html::SetCase LONG]}
  57.     if {[lindex $values 4]} {append text [html::SetCase ABBREV]}
  58.     if {[lindex $values 5]} {append text [html::SetCase SHORT]}
  59.     if {![lindex $values 1] && ![lindex $values 2] && ![lindex $values 5] && [lindex $values 6]} {append text [html::SetCase ",WEEKDAY"]}
  60.     if {![lindex $values 2] && [lindex $values 7]} {append text [html::SetCase ",TIME"]}
  61.     if {![lindex $values 2] && [lindex $values 7] && [lindex $values 8]} {append text [html::SetCase ",SECONDS"]}
  62.     append text \"
  63.     if {![lindex $values 1] && ![lindex $values 2] && [lindex $values 9] != " "} {append text " " [html::SetCase LANG=\"] [lindex $values 9] \"}
  64.     append text "-->"
  65.     set text "$text\r[html::GetLastMod $text]\r<!-- [html::SetCase /#LASTMODIFIED] -->"
  66.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+#LASTMODIFIED[ \t\r\n]+[^>]+>} 0} res] &&
  67.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+/#LASTMODIFIED[ \t\r\n]+[^>]+>} [lindex $res 1]} res2] &&
  68.     [askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  69.         elec::ReplaceText [lindex $res 0] [lindex $res2 1] $text
  70.     } else {
  71.         elec::Insertion [html::OpenCR 1] $text "\r\r"
  72.     }
  73. }
  74.  
  75. proc html::UpdateLastMod {args} {
  76.     global HTMLmodeVars
  77.     set name [lindex $args [expr {[llength $args] - 1}]]
  78.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  79.     set spos [minPos]
  80.     set haswarned 0
  81.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+#LASTMODIFIED[ \t\r\n]+[^>]+>} $spos} res]} {
  82.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r\n]+/#LASTMODIFIED[ \t\r\n]+[^>]+>} [lindex $res 1]} res2]} {
  83.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  84.             return
  85.         }
  86.         set str [html::GetLastMod [getText [lindex $res 0] [expr {[lindex $res 1] + 1}]]]
  87.         if {$str == "0"} {
  88.             if {!$haswarned} {
  89.                 alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  90.                 set haswarned 1
  91.             }
  92.         } else {
  93.             set indent [html::FindIndent [lindex $res 0]]
  94.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $indent $str "\r" $indent
  95.         }
  96.         set spos [lindex $res2 1]
  97.     }
  98.     if {!$HTMLmodeVars(updateMetaDate)} {return}
  99.     set spos [minPos]
  100.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<META[ \t\r\n]+[^<>]+>} $spos} res]} {
  101.         html::ExtractAttrValues [eval getText $res] attrs attrVals errText
  102.         if {[set i [lsearch -exact $attrs NAME=]] < 0 || [string toupper [lindex $attrVals $i]] != "DATE"} {set spos [lindex $res 1]; continue}
  103.         set meta [eval getText $res]
  104.         set date [html::ISOtime]
  105.         regexp {^[0-9]+-[0-9]+-[0-9]+} $date date
  106.         if {[regsub -nocase "(CONTENT\[ \t\r\n\]*=\[ \t\r\n\]*)(\"\[^\"\]*\"|'\[^'\]+'|\[^ \t\n\r\]+)" $meta "\\1\"$date\"" meta]} {
  107.             replaceText [lindex $res 0] [lindex $res 1] $meta
  108.         }
  109.         set spos [lindex $res 1]
  110.     }
  111. }
  112.  
  113. proc html::GetLastMod {str} {
  114.     global html::SpecialCharacter html::TimeFormat html::DateFormat
  115.     set text ""
  116.     set form ""
  117.     set type ""
  118.     set lang ""
  119.     set systemlang ""
  120.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  121.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  122.     ![regexp -nocase {[^,]*} $form type] || 
  123.     [lsearch -exact [list LONG ABBREV SHORT ISO RELAXED] [set type [string toupper $type]]] < 0 ||
  124.     ([regexp -nocase {LANG=\"([^\"]*)\"} $str "" lang] && $lang == "")} {return 0}
  125.     set lang [string tolower $lang]
  126.     regsub -all {([ \.])([a-z])} $lang {\1[string toupper \2]} lang
  127.     regsub {[a-z]} $lang {[string toupper &]} lang
  128.     set lang [subst $lang]
  129.     set text [html::UnQuote $text]
  130.     set day [string match "*WEEKDAY*" [string toupper $form]]
  131.     set tid [string match "*TIME*" [string toupper $form]]
  132.     set sec [string match "*SECONDS*" [string toupper $form]]
  133.  
  134.     if {$type == "ISO" || $type == "RELAXED"} {
  135.         if {$type == "ISO"} {
  136.             set date [html::ISOtime]
  137.         } else {
  138.             set date [mtime [now] relaxed]
  139.             if {!$tid} {
  140.                 regexp {^[0-9]+-[0-9]+-[0-9]+} $date date
  141.             } elseif {!$sec} {
  142.                 regsub {([0-9]+:[0-9]+):[0-9]+} $date "\\1" date
  143.             }
  144.         }
  145.     } else {
  146.         if {$lang != "" && [info exist html::TimeFormat($lang)]} {
  147.             set longdate [mtime [now] long]
  148.             set today [lindex [lindex $longdate 0] 0]
  149.             regexp {[a-zA-Z][^ ,]+} $today today
  150.             set thismonth [lrange [lindex $longdate 0] 1 end]
  151.             regexp {[a-zA-Z][^ ,]+} $thismonth thismonth
  152.             foreach f [array names html::DateFormat] {
  153.                 if {[set weekday [lsearch -exact [lindex [set html::DateFormat($f)] 0] $today]] >= 0 &&
  154.                 [set month [lsearch -exact [lindex [set html::DateFormat($f)] 2] $thismonth]] >= 0} {
  155.                     set systemlang $f
  156.                     regexp {[0-9]+} [lindex $longdate 0] todaysdate
  157.                     set todaysdate [expr {$todaysdate}]
  158.                     regexp {[0-9]+$} [lindex $longdate 0] year
  159.                     break
  160.                 }
  161.             }
  162.         }
  163.         if {$lang != "" && $systemlang != ""} {
  164.             set timeformat [set html::TimeFormat($lang)]
  165.             set dateformat [set html::DateFormat($lang)]
  166.             if {$type == "SHORT"} {
  167.                 set date [lindex $dateformat 6]
  168.                 if {[string length $todaysdate] == 1 && [lindex $dateformat 7]} {
  169.                     set todaysdate "0$todaysdate"
  170.                 }
  171.                 regsub D $date $todaysdate date
  172.                 incr month
  173.                 if {[string length $month] == 1 && [lindex $dateformat 8]} {
  174.                     set month "0$month"
  175.                 }
  176.                 regsub M $date $month date
  177.                 if {![lindex $dateformat 9]} {
  178.                     set year [string range $year 2 3]
  179.                 }
  180.                 regsub Y $date $year date
  181.             } else {
  182.                 set offset 0
  183.                 if {$type == "ABBREV"} {incr offset}
  184.                 set date [lindex $dateformat 4]
  185.                 regsub Y $date $year date
  186.                 if {[string length $todaysdate] == 1 && [lindex $dateformat 5]} {
  187.                     set todaysdate "0$todaysdate"
  188.                 }
  189.                 regsub D $date $todaysdate date
  190.                 regsub M $date [lindex [lindex $dateformat [expr {2 + $offset}]] $month] date
  191.                 if {$day} {
  192.                     regsub W $date [lindex [lindex $dateformat $offset] $weekday] date 
  193.                 } else {
  194.                     regsub {W[, ]+} $date "" date
  195.                 }
  196.             }
  197.             if {$tid} {
  198.                 set tiden [lindex $longdate 1]
  199.                 regexp {^([0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9]+)} $tiden "" hour minute seconds
  200.                 set hour [expr {$hour}]
  201.                 set isAM [regexp {[aA][mM]} $tiden]
  202.                 set is12 [regexp {[aApP][mM]} $tiden]
  203.                 if {$is12} {
  204.                     if {$isAM && $hour == 12} {set hour 0}
  205.                     if {!$isAM && $hour < 12} {incr hour 12}
  206.                 }
  207.                 set hour24 $hour
  208.                 if {![lindex $timeformat 0]} {
  209.                     if {$hour == 0} {set hour 12}
  210.                     if {$hour > 12} {incr hour -12}
  211.                 }
  212.                 if {[string length $hour] == 1 && [lindex $timeformat 4]} {
  213.                     set hour "0$hour"
  214.                 }
  215.                 append date " " $hour [lindex $timeformat 3] $minute
  216.                 if {$sec} {append date [lindex $timeformat 3] $seconds}
  217.                 if {$hour24 < 12} {
  218.                     append date [lindex $timeformat 1]
  219.                 } else {
  220.                     append date [lindex $timeformat 2]
  221.                 }
  222.             }
  223.         } else {
  224.             set date [mtime [now] [string tolower $type]]
  225.             if {!$day && $type != "SHORT"} {
  226.                 set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  227.             }
  228.             if {!$tid} {
  229.                 set date [lindex $date 0]
  230.             } elseif {!$sec} {
  231.                 set tiden [lindex $date 1]
  232.                 regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  233.                 set tiden [lreplace $tiden 0 0 $tidstr]
  234.                 set date [lreplace $date 1 1 $tiden]
  235.             }
  236.             set date [join $date]
  237.             # Work around Y2K bug for Swedish system
  238.             if {$type == "SHORT" && [regexp {^[0-9]-} $date]} {
  239.                 set date "0$date"
  240.             }
  241.         }
  242.     }
  243.     
  244.     set text "$text $date"
  245.     regsub -all "&" $text "\\&" text
  246.     regsub -all "<" $text "\\<" text
  247.     regsub -all ">" $text "\\>" text
  248.     foreach c [array names html::SpecialCharacter] {
  249.         regsub -all $c $text "\\&[set html::SpecialCharacter($c)];" text
  250.     }
  251.  
  252.     return $text
  253. }
  254.  
  255. # Time format
  256. # The items in the arrays are:
  257. # 24 hour clock (true/false)
  258. # am string
  259. # pm string 
  260. # separator
  261. # opening zero for hour (true/false)
  262. set html::TimeFormat(Australian) {0 " AM" " PM" : 0}
  263. set html::TimeFormat(British) {0 " am" " pm" : 0}
  264. set "html::TimeFormat(Canadian French)" {1 "" "" : 1}
  265. set html::TimeFormat(Danish) {1 "" "" : 0}
  266. set html::TimeFormat(Dutch) {1 "" "" : 1}
  267. set html::TimeFormat(Finnish) {1 "" "" : 1}
  268. set html::TimeFormat(Flemish) {1 "" "" : 1}
  269. set html::TimeFormat(French) {1 "" "" : 0}
  270. set html::TimeFormat(German) {1 " Uhr" " Uhr" : 0}
  271. set html::TimeFormat(Italian) {1 "" "" : 0}
  272. set html::TimeFormat(Norwegian) {1 "" "" : 1}
  273. set html::TimeFormat(Spanish) {1 "" "" : 1}
  274. set html::TimeFormat(Swedish) {1 "" "" . 1}
  275. set "html::TimeFormat(Swiss French)" {1 "" "" : 0}
  276. set "html::TimeFormat(Swiss German)" {1 " Uhr" " Uhr" : 0}
  277. set "html::TimeFormat(Swiss Italian)" {1 "" "" : 0}
  278. set html::TimeFormat(U.S.) {0 " AM" " PM" : 0}
  279.  
  280. # Date format 
  281. # The items in the arrays are:
  282. # long weekdays
  283. # short weekdays
  284. # long months
  285. # short months
  286. # long date format
  287. # opening zero for day in long format (true/false)
  288. # short format
  289. # opening zero for day in short format (true/false)
  290. # opening zero for month in short format (true/false)
  291. # show century in short format (true/false)
  292. set html::DateFormat(Australian) {
  293.     {Monday Tuesday Wednesday Thursday Friday Saturday Sunday}
  294.     {Mon Tue Wed Thu Fri Sat Sun}
  295.     {January Februari March April May June July August September October November December}
  296.     {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
  297.     {W D M Y} 0 {D/M/Y} 0 0 0
  298. }
  299.  
  300. set html::DateFormat(British) {
  301.     {Monday Tuesday Wednesday Thursday Friday Saturday Sunday}
  302.     {Mon Tue Wed Thu Fri Sat Sun}
  303.     {January Februari March April May June July August September October November December}
  304.     {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
  305.     {W, M D, Y} 0 {D/M/Y} 0 0 0
  306. }
  307.  
  308. set "html::DateFormat(Canadian French)" {
  309.     {Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche}
  310.     {Lund Mard Merc Jeud Vend Same Dima}
  311.     {janvier février mars avril mai juin juillet août septembre octobre novembre décembre}
  312.     {janv févr mars avri mai juin juil août sept octo nove déce}
  313.     {W D M Y} 1 {D/M/Y} 1 1 0
  314. }
  315.  
  316. set html::DateFormat(Danish) {
  317.     {mandag tirsdag onsdag torsdag fredag lørdag søndag}
  318.     {man tir ons tor fre lør søn}
  319.     {januar februar marts april maj juni juli august september oktober november december}
  320.     {jan feb mar apr maj jun jul aug sep okt nov dec}
  321.     {W D. M Y} 0 {D/M/Y} 1 1 0
  322. }
  323.  
  324. set html::DateFormat(Dutch) {
  325.     {maandag dinsdag woensdag donderdag vrijdag zaterdag zondag}
  326.     {maa din woe don vri zat zon}
  327.     {januari februari maart april mei juni juli augustus september oktober november december}
  328.     {jan feb maa apr mei jun jul aug sep okt nov dec}
  329.     {W, D M Y} 0 {D-M-Y} 1 1 1
  330. }
  331.  
  332. set html::DateFormat(Finnish) {
  333.     {maanantai tiistai keskiviikko torstai perjantai lauantai sunnuntai}
  334.     {ma ti ke to pe la su}
  335.     {tammikuu helmikuu maaliskuu huhtikuu toukokuu kesäkuu heinäkuu elokuu syyskuu lokakuu marraskuu joulukuu}
  336.     {tammi helmi maalis huhti touko kesä heinä elo syys loka marras joulu}
  337.     {W D. M Y} 0 {D.M.Y.} 0 0 1
  338. }
  339.  
  340. set html::DateFormat(Flemish) {
  341.     {maandag dinsdag woensdag donderdag vrijdag zaterdag zondag}
  342.     {maa din woe don vri zat zon}
  343.     {januari februari maart april mei juni juli augustus september oktober november december}
  344.     {jan feb maa apr mei jun jul aug sep okt nov dec}
  345.     {W, D M Y} 0 {D-M-Y} 1 1 1
  346. }
  347.  
  348. set html::DateFormat(French) {
  349.     {lundi mardi mercredi jeudi vendredi samedi dimanche}
  350.     {Lun Mar Mer Jeu Ven Sam Dim}
  351.     {janvier février mars avril mai juin juillet août septembre octobre novembre décembre}
  352.     {jan fév mars avr mai juin juil aoû sep oct nov déc}
  353.     {W D M Y} 0 {D/M/Y} 0 1 0
  354. }
  355.  
  356. set html::DateFormat(German) {
  357.     {Montag Dienstag Mittwoch Donnerstag Freitag Samstag Sonntag}
  358.     {Mon Die Mit Don Fre Sam Son}
  359.     {Januar Februar März April Mai Juni Juli August September Oktober November Dezember}
  360.     {Jan Feb Mär Apr Mai Jun Jul Aug Sep Okt Nov Dez}
  361.     {W, D. M Y} 0 {D.M.Y} 1 1 1
  362. }
  363.  
  364. set html::DateFormat(Italian) {
  365.     {Lunedì Martedì Mercoledì Giovedì Venerdì Sabato Domenica}
  366.     {Lun Mar Mer Gio Ven Sab Dom}
  367.     {gennaio febbraio marzo aprile maggio giugno luglio agosto settembre ottobre novembre dicembre}
  368.     {gen feb mar apr mag giu lug ago set ott nov dic}
  369.     {W, D M Y} 0 {D-M-Y} 0 1 1
  370. }
  371.  
  372. set html::DateFormat(Norwegian) {
  373.     {mandag tirsdag onsdag torsdag fredag lørdag søndag}
  374.     {man tir ons tor fre lør søn}
  375.     {januar februar mars april mai juni juli august september oktober november desember}
  376.     {jan feb mar apr mai jun jul aug sep okt nov des}
  377.     {W D. M Y} 0 {D-M-Y} 1 1 0
  378. }
  379.  
  380. set html::DateFormat(Spanish) {
  381.     {lunes martes miércoles jueves viernes sábado domingo}
  382.     {lun. mart. miér. juev. vier. sáb. dom.}
  383.     {enero febrero marzo abril mayo junio julio agosto septiembre octubre noviembre diciembre}
  384.     {ener febr marz abri mayo juni juli agos sept octu novi dici}
  385.     {W, D M Y} 0 {D/M/Y} 0 0 0
  386. }
  387.  
  388. set html::DateFormat(Swedish) {
  389.     {måndag tisdag onsdag torsdag fredag lördag söndag}
  390.     {mån tis ons tor fre lör sön}
  391.     {januari februari mars april maj juni juli augusti september oktober november december}
  392.     {jan feb mar apr maj jun jul aug sep okt nov dec}
  393.     {W D M Y} 0 {Y-M-D} 1 1 0
  394. }
  395.  
  396. set "html::DateFormat(Swiss French)" {
  397.     {Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche}
  398.     {Lun Mar Mec Jeu Ven Sam Dim}
  399.     {janvier février mars avril mai juin juillet août septembre octobre novembre décembre}
  400.     {jan fév mars avr mai juin juil aoû sep oct nov déc}
  401.     {W, D M Y} 0 {D.M.Y} 0 0 1
  402. }
  403.  
  404. set "html::DateFormat(Swiss German)" {
  405.     {Montag Dienstag Mittwoch Donnerstag Freitag Samstag Sonntag}
  406.     {Mon Die Mit Don Fre Sam Son}
  407.     {Januar Februar März April Mai Juni Juli August September Oktober November Dezember}
  408.     {Jan Feb Mär Apr Mai Jun Jul Aug Sept Okt Nov Dez}
  409.     {W, D. M Y} 0 {D.M.Y} 0 0 1
  410. }
  411.  
  412. set "html::DateFormat(Swiss Italian)" {
  413.     {Lunedì Martedì Mercoledì Giovedì Venerdì Sabato Domenica}
  414.     {Lun Mar Mer Gio Ven Sab Dom}
  415.     {gennaio febbraio marzo aprile maggio giugno luglio agosto settembre ottobre novembre dicembre}
  416.     {gen feb mar apr mag giu lug ago set ott nov dic}
  417.     {W, D M Y} 0 {D.M.Y} 0 0 1
  418. }
  419.  
  420. set html::DateFormat(U.S.) {
  421.     {Monday Tuesday Wednesday Thursday Friday Saturday Sunday}
  422.     {Mon Tue Wed Thu Fri Sat Sun}
  423.     {January February March April May June July August September October November December}
  424.     {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
  425.     {W, M D, Y} 0 {M/D/Y} 0 0 0
  426. }
  427.